home *** CD-ROM | disk | FTP | other *** search
/ Network Supervisor's Toolkit / Network Supervisor's Toolkit.iso / tools / nwtp06 / nwsema.pas < prev    next >
Pascal/Delphi Source File  |  1996-07-10  |  10KB  |  330 lines
  1. {$X+,B-,V-} {essential compiler directives}
  2.  
  3. Unit nwSema;
  4.  
  5. { nwSema unit as of 950301 / NwTP 0.6 API. (c) 1993,1995, R.Spronk }
  6.  
  7. INTERFACE
  8.  
  9. { Primary functions:                    Interrupt: comments:
  10.  
  11. * CloseSemaphore                        (F220/04)
  12. * ExamineSemaphore                      (F220/01)
  13. * GetConnectionsSemaphores              (F217/F1)
  14. * GetSemaphoreInformation               (F217/F2)
  15. * OpenSemaphore                         (F220/00)
  16. * SignalSemaphore                       (F220/03)
  17. * WaitOnSemaphore                       (F220/02)
  18.  
  19. Notes: Functions marked with a '*' have been tested and found correct.
  20. }
  21.  
  22. Uses nwIntr,nwMisc;
  23.  
  24. Type TsemaInfo=record
  25.                ConnNbr:word;
  26.                TaskNbr:word;
  27.                end;
  28.      TsemaInfoList=array[1..100] of TsemaInfo;
  29.      { used by GetSemaphoreInformation }
  30.  
  31.      TconnSema=record
  32.                OpenCount: Byte;
  33.                Value    : Integer;
  34.                TaskNbr  : Word;
  35.                unknown  : byte;         { always 00 ?! }
  36.                Name     : string[127];
  37.                end;
  38.      { used by GetConnectionsSemaphores }
  39.  
  40. Var Result:word;
  41.  
  42. {F220/00 [2.15? 3.x]}
  43. Function OpenSemaphore(SemName : String; InitVal : Integer;
  44.                         VAR SemHandle : LongInt;
  45.                         VAR OpenCount : Word ):Boolean;
  46.  
  47. {F220/01 [2.15? 3.x]}
  48. FUNCTION ExamineSemaphore( SemHandle :LongInt;
  49.                            VAR Value     :Integer;
  50.                            VAR OpenCount :Word     ) :Boolean;
  51. { This functions returns the current value and open count of a semaphore.}
  52.  
  53. {F220/02 [3.x]}
  54. FUNCTION WaitOnSemaphore( SemHandle :LongInt;
  55.                           Wait_Time :Word  ) :Boolean;
  56. { Decrement the semaphore value and, if it is negative,           }
  57. { wait until it becomes non-negative or until a timeout occurs. }
  58.  
  59. {F220/03 [3.x]}
  60. FUNCTION SignalSemaphore(SemHandle:LongInt) : Boolean;
  61. { Increment the semaphore value and release if waiting. }
  62.  
  63. {F220/04 [3.x]}
  64. FUNCTION CloseSemaphore(SemHandle:LongInt) : Boolean;
  65. { Decrement the open count of a semaphore.}
  66. {  When the open count goes to zero, the semaphore is destroyed. }
  67.  
  68.  
  69. {F217/F1 [2.15+? 3.x+]}
  70. Function GetConnectionsSemaphores(ConnNbr:Word;
  71.                            {i/o} Var seqNbr:Word;
  72.                            {out} Var NbrOfSemaLeft:Byte;
  73.                            {out} Var SemaInfo:TconnSema):Boolean;
  74. {Caller needs console privileges }
  75.  
  76. {F217/F2 [2.15? 3.x+]}
  77. Function GetSemaphoreInformation(SemaName:String;
  78.                            {i/o} Var seqNbr:word;
  79.                            {out} Var OpenCount:word;
  80.                                  Var SemValue:Integer;
  81.                                  Var NbrOfSemaLeft:byte;
  82.                                  Var info:TsemaInfoList):Boolean;
  83. { Caller needs console privileges }
  84.  
  85.  
  86. IMPLEMENTATION {=============================================================}
  87.  
  88.  
  89. {F220/00 [3.x]}
  90. Function OpenSemaphore(SemName : String; InitVal : Integer;
  91.                         VAR SemHandle : LongInt;
  92.                         VAR OpenCount : Word ):Boolean;
  93. Type Treq=Record
  94.           subf:byte;
  95.           _InitVal:byte;
  96.           _SemNameLen:byte;
  97.           _SemName:array[0..127] of byte;
  98.           end;
  99.      Trep=record
  100.           _SemHandle:LongInt;
  101.           _OpenCount:Byte;
  102.           end;
  103.      TPreq=^Treq;
  104.      TPrep=^Trep;
  105. begin
  106. With TPreq(GlobalReqBuf)^
  107.  do begin
  108.     subf:=$00;
  109.     If InitVal<0
  110.      then _InitVal:=Lo(256+Initval)
  111.      else _InitVal:=Lo(InitVal);
  112.     UpString(SemName);SemName:=SemName+#0;
  113.     move(semName[1],_SemName[0],ord(SemName[0]));
  114.     _SemNameLen:=ord(semName[0])-1;
  115.     end;
  116. F2SystemCall($20,SizeOf(treq),SizeOf(trep),result);
  117. With TPrep(GlobalReplyBuf)^
  118.  do begin
  119.     SemHandle:=Lswap(_SemHandle);
  120.     OpenCount:=_OPenCount;
  121.     end;
  122. OpenSemaphore:=(result=0);
  123. end;
  124.  
  125.  
  126. {F220/02 [3.x]}
  127. Function WaitOnSemaphore( SemHandle : LongInt;
  128.                            Wait_Time : Word  ) : Boolean;
  129. { Decrement the semaphore value and wait if it is negative.  If negative,}
  130. { the workstation will wait until it becomes non-negative or until a }
  131. { timeout occurs. }
  132. Type Treq=Record
  133.           subf:byte;
  134.           _SemHandle:Longint;
  135.           _wait      :word; { hi-lo }
  136.           end;
  137.      TPreq=^Treq;
  138. begin
  139. With TPreq(GlobalReqBuf)^
  140.  do begin
  141.     subf:=$02;
  142.     _semHandle:=Lswap(SemHandle);
  143.     _wait:=swap(wait_Time);
  144.     end;
  145. F2SystemCall($20,SizeOf(treq),0,result);
  146. WaitOnSemaphore:=(result=0);
  147. end;
  148.  
  149.  
  150. {F220/03 [3.x+]}
  151. Function SignalSemaphore(SemHandle:LongInt) : Boolean;
  152. { Increment the semaphore value and release if waiting.  If any stations}
  153. { are waiting, the station that has been waiting the longest will be    }
  154. { signalled to proceed }
  155. Type Treq=Record
  156.           subf:byte;
  157.           _semhandle:Longint;
  158.           end;
  159.      TPreq=^Treq;
  160. begin
  161. With TPreq(GlobalReqBuf)^
  162.  do begin
  163.     subf:=$03;
  164.     _semHandle:=Lswap(SemHandle);
  165.     end;
  166. F2SystemCall($20,SizeOf(treq),0,result);
  167. SignalSemaphore:=(result=0);
  168. end;
  169.  
  170.  
  171. {F220/04 [3.x+]}
  172. Function CloseSemaphore(SemHandle:LongInt) : Boolean;
  173. { Decrement the open count of a semaphore.  When the open count goes     }
  174. { to zero, the semaphore is destroyed.                                   }
  175. Type Treq=Record
  176.           subf:byte;
  177.           _semhandle:Longint;
  178.           end;
  179.      TPreq=^Treq;
  180. begin
  181. With TPreq(GlobalReqBuf)^
  182.  do begin
  183.     subf:=$04;
  184.     _semHandle:=Lswap(SemHandle);
  185.     end;
  186. F2SystemCall($20,SizeOf(treq),0,result);
  187. CloseSemaphore:=(result=0);
  188. end;
  189.  
  190.  
  191. {F220/01 [2.x/3.x]}
  192. FUNCTION ExamineSemaphore(SemHandle:LongInt;
  193.                            VAR Value     : Integer;
  194.                            VAR OpenCount : Word  )  : Boolean;
  195. { The semaphore value that comes back is the count from the open call }
  196. { - the open count is incremented }
  197. { anytime  a station opens the semaphore this can be used for controlling }
  198. { the number of users using your software }
  199. Type Treq=record
  200.           subf:byte;
  201.           _semHandle:Longint;
  202.           end;
  203.      Trep=record
  204.           _Value:Byte;
  205.           _OpenCount:Byte;
  206.           end;
  207.      TPreq=^Treq;
  208.      TPrep=^Trep;
  209. BEGIN
  210. With TPreq(GlobalReqBuf)^
  211.  DO begin
  212.     subf:=$01;
  213.     _semHandle:=Lswap(SemHandle);
  214.     end;
  215. F2SystemCall($20,SizeOf(Treq),SizeOf(Trep),result);
  216. With TPrep(GlobalReplyBuf)^
  217.  do begin
  218.     if (_Value and $80)>0
  219.      then Value:=254-_Value
  220.      else Value:=_Value;
  221.     OpenCount:=_OpenCount;
  222.     end;
  223. ExamineSemaphore := (result = 0);
  224. END;
  225.  
  226. {F217/F1 [2.15+? 3.x+]}
  227. Function GetConnectionsSemaphores(ConnNbr:Word;
  228.                            {i/o} Var seqNbr:Word;
  229.                            {out} Var NbrOfSemaLeft:Byte;
  230.                            {out} Var SemaInfo:TconnSema):Boolean;
  231. { To be called iteratively. Inital seqNbr=1. Iterate until seqNbr
  232.   becomes 0 (or until NbrOfSemaLeft becomes 0).
  233.  
  234.   This function can return information about several semaphores at the
  235.   same time. However, the size of the reply buffer is limited, causing
  236.   several as of now unsolvable problems. For now this function will
  237.   return information on a per semaphore basis. }
  238. Type Treq=Record
  239.           len:word;
  240.           subf:byte;
  241.           _ConnNbr:word; {lo-hi}
  242.           _SeqNbr:word; {lo-hi}
  243.           end;
  244.      Trep=record
  245.           _NextSeqNbr:word;
  246.           _nbrOfSema:byte;  { word (lo-hi) ? }
  247.           _unknown:byte;    { -^ }
  248.           _SemaInfoBuf:array[1..508] of byte;
  249.           end;
  250.      TPreq=^Treq;
  251.      TPrep=^Trep;
  252. Var i,t:Byte;
  253. begin
  254. With TPreq(GlobalReqBuf)^
  255.  do begin
  256.     len:=SizeOf(Treq)-2;
  257.     subf:=$F1;
  258.     _ConnNbr:=ConnNbr;
  259.     _SeqNbr:=SeqNbr;
  260.     end;
  261. F2SystemCall($17,SizeOf(treq),SizeOf(trep),result);
  262. if result=0
  263.  then With TPrep(GlobalReplyBuf)^
  264.        do begin
  265.           NbrOfSemaLeft:=(_NbrOfSema-1);
  266.           if NbrOfSemaLeft=0
  267.            then seqNbr:=0
  268.            else seqNbr:=seqNbr+1; { unfortunately, _NextSeqNbr returns no valid info. }
  269.  
  270.           Move(_SemaInfoBuf[1],SemaInfo,7+_SemaInfoBuf[7]);
  271.           With SemaInfo
  272.            do begin
  273.               Value:=swap(Value);
  274.               TaskNbr:=swap(TaskNbr);
  275.               end;
  276.           end;
  277. GetConnectionsSemaphores:=(result=0);
  278. { 00 Successful  C6 No console rights  FD Bad connection number }
  279. end;
  280.  
  281. {F217/F2 [2.15? 3.x+]}
  282. Function GetSemaphoreInformation(SemaName:String;
  283.                            {i/o} Var seqNbr:word;
  284.                            {out} Var OpenCount:word;
  285.                                  Var SemValue:Integer;
  286.                                  Var NbrOfSemaLeft:byte;
  287.                                  Var info:TsemaInfoList):Boolean;
  288. Type Treq=Record
  289.           len:word;
  290.           subf:byte;
  291.           _seqNbr: word;
  292.           _semaName:string[127];
  293.           end;
  294.      Trep=record
  295.           _NextSeqNbr:Word;
  296.           _OpenCount:word;
  297.           _SemValue:word;
  298.           _NbrOfRecords:word;
  299.           _SemaInfoBuf:array[1..514] of byte;
  300.           end;
  301.      TPreq=^Treq;
  302.      TPrep=^Trep;
  303. begin
  304. UpString(SemaName);
  305. if SemaName[0]>#127
  306.  then SemaName[0]:=#127;
  307. With TPreq(GlobalReqBuf)^
  308.  do begin
  309.     subf:=$F2;
  310.     _seqNbr:=seqNbr;
  311.     _SemaName:=SemaName;
  312.     len:=4+ord(_SemaName[0]);
  313.     end;
  314. F2SystemCall($17,SizeOf(treq),SizeOf(trep),result);
  315. With TPrep(GlobalReplyBuf)^
  316.  do begin
  317.     OpenCount:=_OpenCount;
  318.     SemValue:=Integer(_SemValue);
  319.     NbrOfSemaLeft:=_NbrOfRecords;
  320.     move(_SemaInfoBuf,Info,SizeOf(TsemaInfoList));
  321.     if NbrOfSemaLeft>100
  322.      then seqNbr:=seqNbr+100
  323.      else seqNbr:=0;
  324.     end;
  325. GetSemaphoreInformation:=(result=0);
  326. { 00 Successful  C6 No console rights }
  327. end;
  328.  
  329.  
  330. END.